(in-package :experiment)

(defvar *skip-log-file* nil
  "Don't write to the log file if this is non-NIL. Used when a
read-only file system is detected.")

(defgeneric log (experiment id &key &allow-other-keys)
  (:documentation "log a line to the log file. to make readability and
parsing easier, all arguments after the id are keyword pairs."))
(defgeneric lg (id &key &allow-other-keys)
  (:documentation "log a line to the log file like LOG, but use the *experiment* variable to find the experiment instance."))

(defun openp (stream)
  (and (streamp stream)
       (open-stream-p stream)))

(defun ensure-stream (exp file slot)
  (unless (and (streamp (slot-value exp slot))
               (openp (slot-value exp slot)))
    (setf (slot-value exp slot)
          (open file
                :direction :output
                :if-exists :append
                :if-does-not-exist :create))))

(defun ensure-log-stream (exp)
  (ensure-stream exp (experiment-log-file exp) 'log-stream))

(defun ensure-event-stream (exp)
  (ensure-stream exp (experiment-event-file exp) 'event-stream))

(defun close-log-stream (exp)
  (when (openp (log-stream exp))
    (close (log-stream exp))))

(defun close-event-stream (exp)
  (when (openp (event-stream exp))
    (close (event-stream exp))))

(defun base-log (exp state id keys)
  (unless *skip-log-file*
    (ensure-log-stream exp)
    (format (log-stream exp) "(~d ~a ~a~{ ~s~})~%"
            (- (gwee:now) (experiment-start-time exp))
            (if state
                (type-of state)
                'experiment)
            id
            keys)
    (finish-output (log-stream exp))))

(defmethod log ((exp experiment) id &rest keys &key &allow-other-keys)
  (base-log exp (current-state exp) id keys))

(defmethod log ((state state) id &rest keys &key &allow-other-keys)
  (base-log *experiment* state id keys))

(defmethod lg (id &rest keys &key &allow-other-keys)
  (base-log *experiment* (current-state *experiment*) id keys))

(defun get-log-file (id template)
  (ensure-directories-exist (gwee:top-level-path "logs/"))
  (gwee:top-level-path (format nil (format nil "logs/~a" template) id)))

(defun get-suspend-file (id)
  (ensure-directories-exist (gwee:top-level-path "save/"))
  (gwee:top-level-path (format nil "save/suspend-~a.txt" id)))

(defun read-only-fs-p ()
  "Detect whether we're in on a read-only file system."
  (handler-case
      (let ((file (make-pathname :name (format nil "readonlyfscheck-~d" (random 100000))
                                 :type nil
                                 :defaults (gwee:top-level-path "read-only-fs"))))
        (with-open-file (s file :direction :output) (declare (ignore s)))
        (delete-file file)
        nil)
    #+lispworks (conditions:file-stream-error (s)
                  ;; 30 is the error code for read-only file system
                  (eql (slot-value s 'conditions::errno) 30))
    #-(or lispworks) (error (s)
                       (error "unimplemented."))))

(defun get-event-file (id template)
  (gwee:top-level-path (format nil (format nil "logs/~a" template) id)))

(defun log-event-start ()
  (unless *skip-log-file*
    (ensure-event-stream *experiment*)
    (write-line ";; experiment start" (event-stream *experiment*))
    (finish-output (event-stream *experiment*))))

(defun log-event (type args)
  (unless *skip-log-file*
    (ensure-event-stream *experiment*)
    (format (event-stream *experiment*) "(~d ~a~{ ~s~})~%"
            (- (gwee:now) (experiment-start-time *experiment*))
            type args)
    (finish-output (event-stream *experiment*))))

(defun event-hook (event)
  (let ((type (cffi:foreign-enum-keyword 'sdl-cffi::Sdl-Event-Type
                                         (cffi:foreign-slot-value event 'sdl-cffi::sdl-event
                                                                  'sdl-cffi::type))))
    (when *experiment*
      (case type
        ((:sdl-key-down-event :sdl-key-up-event)
         (log-event type (gwee::key-event-slots event)))
        ((:sdl-mouse-button-down-event :sdl-mouse-button-up-event)
         (log-event type (gwee::mouse-click-event-slots event)))
        (:sdl-mouse-motion-event
         (log-event type (gwee::mouse-motion-event-slots event)))
        (:sdl-video-resize-event
         (log-event type (gwee::resize-event-slots event)))
        (t (log-event type nil))))))
